home *** CD-ROM | disk | FTP | other *** search
/ Speccy ClassiX 1998 / Speccy ClassiX 98.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexx / ArcAlpha.rexx < prev    next >
OS/2 REXX Batch file  |  1994-11-18  |  9KB  |  368 lines
  1. /* $VER: ArcAlpha.rexx 8.3 (18.11.94)
  2. ⌐ 1990-94 Richard Lee Stockton - FREELY DISTRIBUTABLE
  3. archives user defined alphafilelist into file in users email
  4. receives its arguments from rexxDoors/Make_BrowseList.rexx
  5. */
  6.  
  7. CALL TIME('R')
  8.  
  9. SIGNAL ON ERROR
  10. SIGNAL ON SYNTAX
  11. OPTIONS FAILAT 999999
  12.  
  13. PARSE ARG name lastbrowse alphaflag libflag numlist
  14. lastbrowse=STRIP(lastbrowse)
  15.  
  16. IF ~DATATYPE(lastbrowse,'N') | name='' | numlist='' THEN
  17.   CALL GETOUT(20)
  18.  
  19. figarg='s:CONFIG.BBS'
  20. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  21. x=OPEN(f,figarg,'R')
  22. IF x=0 THEN
  23.   DO
  24.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  25.     CALL GETOUT(21)
  26.   END
  27. lynes.=''
  28. DO i=1 TO 33
  29.   lynes.i=READLN(f)
  30. END
  31. CALL CLOSE(f)
  32.  
  33. compos=POS('/*',lynes.1)
  34. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  35. bbsname = STRIP(lynes.1)
  36. sysop   = WORD(lynes.2,1)
  37. bbspath = WORD(lynes.6,1)
  38. IF ~EXISTS(bbspath) THEN
  39.   DO
  40.     SAY bbspath 'does not exist!'
  41.     CALL GETOUT(22)
  42.   END
  43. testchar=RIGHT(bbspath,1)
  44. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  45. libpath=WORD(lynes.8,1)
  46. IF ~EXISTS(libpath) THEN
  47.   DO
  48.     SAY libpath 'does not exist!'
  49.     CALL GETOUT(23)
  50.   END
  51. testchar=RIGHT(libpath,1)
  52. IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
  53. IF WORD(lynes.25,1)=1 THEN scratch=bbspath'Scratch'
  54. ELSE scratch='RAM:Scratch'
  55.  
  56. DO i=1
  57.   IF GETCLIP('BBS_ALPHA'i)='' THEN  /* info clip for external STOP */
  58.     DO
  59.       CALL SETCLIP('BBS_ALPHA'i,name)
  60.       clipnum=i
  61.       LEAVE i
  62.     END
  63. END
  64.  
  65. CALL CLOSE(STDOUT)
  66. CALL OPEN(STDOUT,scratch'/ArcAlpha.STDOUT'clipnum,'W')
  67. SAY STRIP(SUBSTR(SOURCELINE(1),3))
  68. SAY
  69.  
  70. CALL PRAGMA('P',-3)         /* lower the priority of this task */
  71.  
  72. extension=WORD(lynes.32,1)
  73. arccom=lynes.33
  74. compos=POS('/*',lynes.33)
  75. IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
  76. arccom=STRIP(lynes.33)
  77. IF LEFT(extension,1)~='.' THEN
  78.   DO
  79.     extension='.lzh'
  80.     arccom='lharc -m m'
  81.   END
  82.  
  83. filepath=bbspath'EmailFiles/'name
  84. CALL MAKEDIR(filepath)
  85. x=OPEN(f,bbspath'Numbers/LastMail','R')
  86. IF x=0 THEN
  87.   DO
  88.     CALL DELAY(100)
  89.     x=OPEN(f,bbspath'Numbers/LastMail','R')
  90.   END
  91. IF x=0 THEN lastm=1
  92. ELSE lastm=READLN(f)+1
  93. CALL CLOSE(f)
  94. ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
  95. alphaname=filepath'/BBBBS_'lastm
  96.  
  97. dirs.=''
  98. x=OPEN(f,bbspath'Lists/Libraries','R')
  99. IF x=0 THEN CALL GETOUT(24)
  100. DO i=1
  101.   line=READLN(f)
  102.   IF line='END' | EOF(f) THEN LEAVE i
  103.   num=WORD(line,1)
  104.   IF ~DATATYPE(num,'W') THEN ITERATE i
  105.   dirs.num=WORD(line,2)
  106. END
  107. CALL CLOSE(f)
  108.  
  109. filelist.=''
  110. filelist.0=0
  111. IF alphaflag='D' THEN
  112.   DO
  113.     x=OPEN(f,bbspath'Lists/Files','R')
  114.     IF x=0 THEN CALL GETOUT(24)
  115.     DO i=1
  116.       line=READLN(f)
  117.       IF EOF(f) THEN LEAVE i
  118.       num=WORD(line,1)
  119.       IF ~DATATYPE(num,'W') THEN ITERATE i
  120.       filelist.num=WORD(line,3)
  121.       IF num>filelist.0 THEN filelist.0=num
  122.     END
  123.     CALL CLOSE(f)
  124.     alphalist.=''
  125.     IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','R') THEN CALL GETOUT(29)
  126.     DO i=1
  127.       line=READLN(f)
  128.       IF EOF(f) THEN LEAVE i
  129.       alphalist.i=line
  130.       num=WORD(line,3)
  131.       filelist.num.0=i
  132.     END
  133.     CALL CLOSE(f)
  134.     alphalist.0=i-1
  135.   END
  136. x=OPEN(a,alphaname,'W')
  137. IF x=0 THEN CALL GETOUT(25)
  138. title='=' bbsname
  139. IF alphaflag='A' THEN title=title 'alphabetical'
  140. ELSE title=title 'newest to oldest'
  141. title=title', single-line file descriptions'
  142. CALL WRITELN(a,title)
  143. CALL WRITELN(a,'= Custom archived for' name'  'DATE() TIME('C'))
  144. IF libflag='A' THEN
  145.   DO
  146.     CALL WRITELN(a,'')
  147.     CALL WRITELN(a,'Filename          Bytes File# Library         KeyWords')
  148.     CALL WRITELN(a,LEFT('=',77,'='))
  149.   END
  150. CALL CLOSE(a)
  151.  
  152. x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
  153. IF x=0 THEN CALL GETOUT(28)
  154. CALL WRITELN(f,' Mail: 'lastm'   FILE: BBBBS_'lastm)
  155. CALL WRITELN(f,' From: BBBBS')
  156. CALL WRITELN(f,'   To: 'name)
  157. CALL WRITELN(f,' Subj: AlphaList')
  158. CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
  159. CALL WRITELN(f,LEFT('=',75,'='))
  160. CALL WRITELN(f,'Here are the single line file descriptions you requested.')
  161. CALL WRITELN(f,'The collection process was interrupted.')
  162. CALL CLOSE(f)
  163.  
  164. IF alphaflag='A' THEN
  165.   DO
  166.     IF libflag='L' THEN
  167.       DO
  168.         x=OPEN(a,alphaname,'A')
  169.         IF x=0 THEN RETURN
  170.         DO i=1 TO WORDS(numlist)
  171.           dnum=WORD(numlist,i)
  172.           CALL WRITELN(a,'')
  173.           IF dirs.dnum='' THEN
  174.             DO
  175.               line='Library' dnum 'does not exist!'
  176.               CALL WRITELN(a,line)
  177.               ITERATE i
  178.             END
  179.           x=OPEN(f,libpath||dirs.dnum'/.'STRIP(LEFT(dirs.dnum,15)),'R')
  180.           IF x=0 THEN
  181.             DO
  182.               line='Library' dnum dirs.dnum 'filelist failed to open for reading!'
  183.               CALL WRITELN(a,line)
  184.               ITERATE i
  185.             END
  186.           DO j=1
  187.             line=READLN(f)
  188.             IF EOF(f) THEN LEAVE j
  189.             CALL WRITELN(a,line)
  190.           END
  191.           CALL CLOSE(f)
  192.         END
  193.         CALL CLOSE(a)
  194.       END
  195.     ELSE CALL write_alist(numlist)
  196.   END
  197. ELSE
  198.   DO
  199.     IF libflag='L' THEN
  200.       DO i=1 TO WORDS(numlist)
  201.         CALL write_dlist(WORD(numlist,i))
  202.       END
  203.     ELSE CALL write_dlist(numlist)
  204.   END
  205.  
  206. IF WORD(STATEF(alphaname),2)<40 THEN CALL GETOUT(26)
  207. CALL PRAGMA('P',0)         /* normal priority */
  208. ADDRESS COMMAND arccom alphaname||extension alphaname
  209. IF ~EXISTS(alphaname||extension) THEN CALL GETOUT(27)
  210. CALL PRAGMA('P',-3)
  211. x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
  212. IF x=0 THEN CALL GETOUT(28)
  213. CALL WRITELN(f,' Mail: 'lastm'   FILE: BBBBS_'lastm||extension)
  214. CALL WRITELN(f,' From: BBBBS')
  215. CALL WRITELN(f,'   To: 'name)
  216. CALL WRITELN(f,' Subj: AlphaList')
  217. CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
  218. CALL WRITELN(f,LEFT('=',75,'='))
  219. CALL WRITELN(f,'Here are the single line file descriptions you requested.')
  220. t=(.5+TIME('E'))%1
  221. min=t%60
  222. hrs=min%60
  223. min=min//60
  224. sec=t//60
  225. temp='It took'
  226. IF hrs>1 THEN temp=temp hrs 'hours'
  227. ELSE IF hrs=1 THEN temp=temp '1 hour'
  228. IF min>1 THEN temp=temp min 'minutes'
  229. ELSE IF min=1 THEN temp=temp '1 minute'
  230. IF sec=1 THEN temp=temp '1 second'
  231. ELSE IF sec>0 THEN temp=temp sec 'seconds'
  232. temp=temp 'to compile this list.'
  233. CALL WRITELN(f,temp)
  234. CALL CLOSE(f)
  235.  
  236. newmess='Your archived alphabetical filelist is waiting in Email.'
  237. IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
  238.   DO
  239.     oldmess=GETCLIP('BBS_MESSAGE')
  240.     IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
  241.     CALL SETCLIP('BBS_MESSAGE',oldmess||newmess)
  242.   END
  243. IF GETCLIP('BBS_LOCAL')=name THEN CALL SETCLIP('BBS_LOCAL_MSG',newmess)
  244. CALL GETOUT(0)
  245. EXIT
  246.  
  247.  
  248. write_alist:
  249. ARG nlist
  250. nlist=STRIP(nlist)
  251. x=OPEN(a,alphaname,'A')
  252. IF x=0 THEN RETURN
  253. count=0
  254. IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','R') THEN
  255.   DO
  256.     CALL CLOSE(f)
  257.     CALL CLOSE(a)
  258.     RETURN
  259.   END
  260. CALL CLOSE(f)
  261. ADDRESS COMMAND 'COPY' bbspath'Lists/Files.ALPHA' bbspath'Lists/Files.ALPHA.arcalpha'
  262. IF ~listOPEN(f,bbspath'Lists/Files.ALPHA.arcalpha','R') THEN
  263.   DO
  264.     CALL CLOSE(f)
  265.     CALL CLOSE(a)
  266.     RETURN
  267.   END
  268. DO j=1
  269.   line=READLN(f)
  270.   IF EOF(f) THEN LEAVE j
  271.   IF j//5=0 THEN
  272.     DO
  273.       t=GETCLIP('BBS_STOP_ALPHA'clipnum)
  274.       IF t~='' THEN CALL cleanup(t)
  275.     END
  276.   IF WORD(line,3)<=lastbrowse THEN ITERATE j
  277.   IF FIND(nlist,WORD(line,4))=0 THEN ITERATE j
  278.   CALL WRITELN(a,line)
  279.   count=count+1
  280. END
  281. CALL CLOSE(f)
  282. CALL WRITELN(a,' 'count' files.')
  283. CALL WRITELN(a,'')
  284. CALL CLOSE(a)
  285. CALL DELETE(bbspath'Lists/Files.ALPHA.arcalpha')
  286. RETURN
  287.  
  288.  
  289. write_dlist:
  290. ARG nlist
  291. nlist=STRIP(nlist)
  292. x=OPEN(a,alphaname,'A')
  293. IF x=0 THEN RETURN
  294. IF libflag='L' THEN
  295.   DO
  296.     CALL WRITELN(a,'')
  297.     CALL WRITELN(a,'File Library' nlist)
  298.     CALL WRITELN(a,'Filename          Bytes File# Library         KeyWords')
  299.     CALL WRITELN(a,LEFT('=',77,'='))
  300.   END
  301. count=0
  302. DO k=filelist.0 TO 1 BY -1
  303.   IF filelist.k='' THEN ITERATE k
  304.   IF k//5=0 THEN
  305.     DO
  306.       t=GETCLIP('BBS_STOP_ALPHA'clipnum)
  307.       IF t~='' THEN CALL cleanup(t)
  308.     END
  309.   IF k<=lastbrowse THEN LEAVE k
  310.   j=filelist.k.0
  311.   IF ~DATATYPE(j,'W') THEN ITERATE k
  312.   IF FIND(nlist,WORD(alphalist.j,4))=0 THEN ITERATE k
  313.   CALL WRITELN(a,alphalist.j)
  314.   count=count+1
  315. END
  316. CALL WRITELN(a,' 'count' files.')
  317. CALL WRITELN(a,'')
  318. CALL CLOSE(a)
  319. RETURN
  320.  
  321.  
  322. listOPEN:
  323. PARSE ARG fh,listfile,flag
  324. DO i=0 TO 59 WHILE OPEN(fh,listfile,flag)=0
  325.   IF i//4=0 THEN SAY 'Waiting' (60-i)*5 'more seconds for' listfile 'to become available...'
  326.   CALL DELAY(250)
  327. END
  328. IF i>59 THEN
  329.   DO
  330.     SAY '*** unable to access' listfile 'list.'
  331.     RETURN 0
  332.   END
  333. RETURN 1
  334.  
  335.  
  336. cleanup:
  337. ARG t2 .
  338. CALL CLOSE(a)
  339. SAY 'User aborted!'
  340. IF t2='DELETE' THEN
  341.   DO
  342.     CALL DELETE(alphaname)
  343.     x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'A')
  344.     IF x~=0 THEN
  345.       DO
  346.         CALL WRITELN(f,'')
  347.         CALL WRITELN(f,'*** This process aborted' DATE() 'at' TIME('C') '***')
  348.         CALL WRITELN(f,'*** No data file exists, not even a partial one. ***')
  349.         CALL CLOSE(f)
  350.       END
  351.   END
  352. CALL GETOUT(0)
  353. RETURN
  354.  
  355.  
  356. ERROR:
  357. SYNTAX:
  358. GETOUT:
  359. ARG errorout 
  360. CALL SETCLIP('BBS_BROWSE')
  361. CALL SETCLIP('BBS_ALPHA'clipnum)
  362. CALL SETCLIP('BBS_STOP_ALPHA'clipnum)
  363. IF errorout>0 THEN SAY 'ArcAlpha error' errorout'!'
  364. EXIT(errorout)
  365.  
  366.  
  367. /* ArcAlpha.rexx */
  368.